<%
Class FastAsp_JSON
    '编码
    Public Function Encode(byval data)
        Select Case VarType(data)
            Case vbNull
                Encode = "null"
            Case vbBoolean
                Encode = LCase(CStr(data))
            Case vbInteger, vbLong, vbSingle, vbDouble
                Encode = data
            Case vbString
                Encode = """" & JSEncode(data) & """"
            Case vbArray, 8194, 8204, 8209 'Array,Byte,Integer,Long
                Encode = ArrayToJSON(data)
            Case vbObject
                If TypeName(data) = "Dictionary" Then
                    Encode = DictToJSON(data)
                ElseIf TypeName(data) = "Recordset" Then
                    Encode = RsToJSON(data)
                Else
                    Encode = "{}"
                End If
            Case Else
                Encode = """"
        End Select
    End Function
    
    '解码
    Public Function Decode(byval jsonStr)
        Set Decode = ParseJSON(jsonStr)
    End Function
    
    '数组转JSON
    Private Function ArrayToJSON(byval arr)
        Dim i, items : items = ""
        For i = 0 To UBound(arr)
            If items <> "" Then items = items & ","
            items = items & Encode(arr(i))
        Next
        ArrayToJSON = "[" & items & "]"
    End Function
    
    '字典转JSON
    Private Function DictToJSON(byval dict)
        Dim key, items : items = ""
        For Each key In dict.Keys
            If items <> "" Then items = items & ","
            items = items & """" & key & """:" & Encode(dict(key))
        Next
        DictToJSON = "{" & items & "}"
    End Function
    
    '记录集转JSON
    Private Function RsToJSON(byval rs)
        If rs.EOF Then
            RsToJSON = "[]"
            Exit Function
        End If
        
        Dim arr(), dict, i, j
        ReDim arr(rs.RecordCount-1)
        i = 0
        Do While Not rs.EOF
            Set dict = Server.CreateObject("Scripting.Dictionary")
            For j = 0 To rs.Fields.Count-1
                dict.Add rs.Fields(j).Name, rs.Fields(j).Value
            Next
            Set arr(i) = dict
            rs.MoveNext
            i = i + 1
        Loop
        RsToJSON = ArrayToJSON(arr)
    End Function
    
    'JavaScript编码
    Private Function JSEncode(byval str)
        If IsNull(str) Then
            JSEncode = ""
            Exit Function
        End If
        
        str = Replace(str, "\", "\\")
        str = Replace(str, """", "\""")
        str = Replace(str, vbCrLf, "\n")
        str = Replace(str, vbCr, "\n")
        str = Replace(str, vbLf, "\n")
        str = Replace(str, vbTab, "\t")
        JSEncode = str
    End Function
    
    '解析JSON
    Private Function ParseJSON(byval str)
        Set ParseJSON = Server.CreateObject("Scripting.Dictionary")
        
        str = Trim(str)
        If Left(str, 1) <> "{" Or Right(str, 1) <> "}" Then
            Exit Function
        End If
        
        str = Mid(str, 2, Len(str)-2)
        Dim arr, i, item, key, val
        arr = Split(str, ",")
        For i = 0 To UBound(arr)
            item = Trim(arr(i))
            If item <> "" Then
                key = Trim(Left(item, InStr(item, ":")-1))
                val = Trim(Mid(item, InStr(item, ":")+1))
                If Left(key, 1) = """" Then key = Mid(key, 2, Len(key)-2)
                If Left(val, 1) = """" Then val = Mid(val, 2, Len(val)-2)
                ParseJSON.Add key, val
            End If
        Next
    End Function
End Class
%> 